home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / exceptions.pl < prev    next >
Text File  |  2009-10-01  |  2KB  |  62 lines

  1. # exceptions.pl
  2. # tchrist@convex.com
  3. #
  4. # This library is no longer being maintained, and is included for backward
  5. # compatibility with Perl 4 programs which may require it.
  6. #
  7. # In particular, this should not be used as an example of modern Perl
  8. # programming techniques.
  9. #
  10. # Here's a little code I use for exception handling.  It's really just
  11. # glorfied eval/die.  The way to use use it is when you might otherwise
  12. # exit, use &throw to raise an exception.  The first enclosing &catch
  13. # handler looks at the exception and decides whether it can catch this kind
  14. # (catch takes a list of regexps to catch), and if so, it returns the one it
  15. # caught.  If it *can't* catch it, then it will reraise the exception
  16. # for someone else to possibly see, or to die otherwise.
  17. # I use oddly named variables in order to make darn sure I don't conflict 
  18. # with my caller.  I also hide in my own package, and eval the code in his.
  19. # The EXCEPTION: prefix is so you can tell whether it's a user-raised
  20. # exception or a perl-raised one (eval error).
  21. # --tom
  22. #
  23. # examples:
  24. #    if (&catch('/$user_input/', 'regexp', 'syntax error') {
  25. #        warn "oops try again";
  26. #        redo;
  27. #    }
  28. #
  29. #    if ($error = &catch('&subroutine()')) { # catches anything
  30. #
  31. #    &throw('bad input') if /^$/;
  32.  
  33. sub catch {
  34.     package exception;
  35.     local($__code__, @__exceptions__) = @_;
  36.     local($__package__) = caller;
  37.     local($__exception__);
  38.  
  39.     eval "package $__package__; $__code__";
  40.     if ($__exception__ = &'thrown) {
  41.     for (@__exceptions__) {
  42.         return $__exception__ if /$__exception__/;
  43.     } 
  44.     &'throw($__exception__);
  45.     } 
  46.  
  47. sub throw {
  48.     local($exception) = @_;
  49.     die "EXCEPTION: $exception\n";
  50.  
  51. sub thrown {
  52.     $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
  53.  
  54. 1;
  55.